{-# LANGUAGE NoImplicitPrelude #-}

{-
    BNF Converter: Template Generator
    Copyright (C) 2004  Author:  Markus Forberg

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1335, USA
-}


module BNFC.Backend.Haskell.CFtoTemplate (cf2Template) where

import Prelude'

import BNFC.CF
import BNFC.PrettyPrint
import BNFC.Utils                 ( ModuleName )
import BNFC.Backend.Haskell.Utils ( catvars )

cf2Template :: ModuleName -> ModuleName -> Bool -> CF -> String
cf2Template skelName absName functor cf = unlines
    [ "-- Haskell module generated by the BNF converter"
    , ""
    , "module "++ skelName ++ " where"
    , ""
    , "import qualified " ++ absName
    , ""
    , "type Err = Either String"
    , "type Result = Err String"
    , ""
    , "failure :: Show a => a -> Result"
    , "failure x = Left $ \"Undefined case: \" ++ show x\n"
    , unlines $ map (render . \(s,xs) -> case_fun absName functor s xs) $ specialData cf ++ cf2data cf
    ]

-- |
-- >>> case_fun "M" False (Cat "Expr") [("EInt", [TokenCat "Integer"]), ("EAdd", [Cat "Expr", Cat "Expr"])]
-- transExpr :: M.Expr -> Result
-- transExpr x = case x of
--   M.EInt integer -> failure x
--   M.EAdd expr1 expr2 -> failure x
--
-- >>> case_fun "" True (Cat "Expr") [("EInt", [TokenCat "Integer"]), ("EAdd", [Cat "Expr", Cat "Expr"])]
-- transExpr :: Show a => Expr a -> Result
-- transExpr x = case x of
--   EInt _ integer -> failure x
--   EAdd _ expr1 expr2 -> failure x
--
-- TokenCat are not generated as functors:
-- >>> case_fun "" True (TokenCat "MyIdent") [("MyIdent", [TokenCat "String"])]
-- transMyIdent :: MyIdent -> Result
-- transMyIdent x = case x of
--   MyIdent string -> failure x
case_fun :: ModuleName -> Bool -> Cat -> [(Fun,[Cat])] -> Doc
case_fun absName functor' cat xs = vcat
    [ fname <+> "::" <+> iffunctor "Show a =>" <+> type_ <+> "-> Result"
    , fname <+> "x = case x of"
    , nest 2 $ vcat (map mkOne xs)
    ]
  where
    -- If the functor option is set AND the category is not a token type,
    -- then the type is a functor.
    iffunctor doc | functor' && not (isTokenCat cat) = doc
                  | otherwise = empty
    type_ = qualify $ cat' <+> iffunctor "a"
    fname = "trans" <> cat'
    cat' =  text (show cat)
    mkOne (cons, args) =
        let ns = catvars args -- names False (map (checkRes .var) args) 1
        in  qualify (text cons) <+> iffunctor "_" <+> hsep ns <+> "-> failure x"
    qualify :: Doc -> Doc
    qualify
      | null absName = id
      | otherwise    = (text absName <> "." <>)
